Language/OS - Multiplatform Resource Library

home *** CD-ROM | disk | FTP | other *** search

/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / Foible / FlowKit / FlowKit2.st < prev next >

Wrap

Text File | 1993-07-24 | 91KB | 4,117 lines

'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 18 May 1990 at 7:18:26 pm'! BoxWithPorts subclass: #FlowKitBox instanceVariableNames: 'permanentForm value companion ' classVariableNames: 'SmallTextStyle ' poolDictionaries: '' category: 'FlowKit'! FlowKitBox comment: 'FlowKitBox is the abstract class for all Boxes in FlowKit instance variables: permanentForm is the form that holds the FlowKitBox''s basic image value holds the value of the FlowKitBox companion is the Box that corresponds to the FlowKitBox in the other view'! !FlowKitBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" | formulas | formulas _ self formulas. someValues isEmpty ifTrue: [self value: (formulas collect: [:each | each value: self])] ifFalse: [self value: (formulas collect: [:each | each valueWithArguments: someValues asArray])]. ^self value! firstValue "return the first value of the receiver" ^self value at: 1! firstValue: aValue "set the first value of the receiver" self value at: 1 put: aValue! getInputValues "get the input values needed for a calculation of the receiver's value" inputPorts do: [:each | each value isNil ifTrue: [^nil]]. ^inputPorts collect: [:each | each value]! initValue: aValue "give the receiver an initial value" self value: aValue! outputResults: results "display the results of the receiver's calculation" self displayValue: results. outputPort with: results do: [:prt :res | prt token: res]! token "the sender, an input port, has received a new value for use in the receiver's calculation" | values results | values _ self getInputValues. values isNil ifTrue: [^nil]. results _ self calculateValue: values. self outputResults: results! value "return the value of the receiver" ^value! value: aValue "set the value of the receiver" value _ aValue! ! !FlowKitBox methodsFor: 'interface tests'! acceptsDataLinks: aPoint "Return whether I accept DataLinks at the user interface" | port | port _ self findInputPort: aPoint. ^port isNil not! canAcceptInput "by default, boxes can't accept input" ^false! canBeCalibrated "Return whether I can be calibrated" ^false! givesDataLinks: aPoint "Return whether I give DataLinks at the user interface" | port | port _ self findOutputPort: aPoint. ^port isNil not! ! !FlowKitBox methodsFor: 'displaying'! displayBox "returns boundingBox of the receiver if it displays its value, nil otherwise" ^nil! displayValue "displays the receiver's current value" ^self subclassResponsibility! displayValue: someValues "display someValues, the receiver's new value, implemented by subclass" ^self! ! !FlowKitBox methodsFor: 'form access'! addInput: aValue toForm: aForm "display aValue on aForm and return it" self subclassResponsibility! baseForm "Return a copy of the Form representing the receiver" ^permanentForm deepCopy! createForms "This is the method that creates the form." | aForm | aForm _ self baseForm. aForm offset: 0@0. forms add: aForm! inputForm "return a copy of the receiver's form with the current input displayed " self subclassResponsibility! inputForm: aValue "return a copy of the receiver's form with aValue displayed on it" self subclassResponsibility! permanentForm: aForm "set the permanent form of the receiver to be aForm" permanentForm _ aForm! ! !FlowKitBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint with form aForm " name isNil ifFalse: [^self error: 'Cannot reinitialize a ' , self class name]. name _ aName. self permanentForm: aForm. self offset: aPoint. owner _ aManager! ! !FlowKitBox methodsFor: 'accessing'! acceptInput: aPoint "default method for a box to get input, if it accepts input. The point where the box was poked is supplied if needed." | oldInput newInput | oldInput _ self value. oldInput isNil ifTrue: [oldInput _ ''] ifFalse: [oldInput _ oldInput first]. newInput _ FillInTheBlank request: 'Enter Input for this Box' initialAnswer: oldInput printString. ^newInput! companion "return the box which is the receiver's companion box" ^companion! companion: aBox "let the receiver know that aBox is its companion box" companion _ aBox! formulas ^self class formulas! ! !FlowKitBox methodsFor: 'port access'! findInputPort: aPoint "find and return an input port that can be linked to at aPoint" inputPorts isNil ifTrue: [^nil]. "see if user hit a port right on the nose. If so give it to him." inputPorts do: [:each | ((each boundingBox containsPoint: aPoint) and: [each link isNil]) ifTrue: [^each]]. "If no input port was hit, return first empty one." inputPorts do: [:each | each link isNil ifTrue: [^each]]. "If none available ..." ^nil! findOutputPort: aPoint "find and return an output port that can be linked to at aPoint " outputPort isNil ifTrue: [^nil]. outputPort do: [:each | ((each boundingBox containsPoint: aPoint) "and: [each link isNil]" ) " ask Dan if this is correct " ifTrue: [^each]]. ^nil! initInputPortsFromRectangles: rectangles "initialize the input ports of the receiver" inputPorts _ rectangles collect: [:each | (FlowKitInputPort new: each) box: self]! initOutputPortsFromRectangles: rectangles "initialize the output ports of the receiver" outputPort _ rectangles collect: [:each | (FlowKitOutputPort new: each) box: self]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FlowKitBox class instanceVariableNames: 'formulas '! FlowKitBox class comment: 'The class instance variable formulas holds a collection of blocks that are evaluated when the FlowKitBox''s value is calculated, each formula''s value is sent to a corresponding output Port'! !FlowKitBox class methodsFor: 'accessing'! formulas ^formulas! ! !FlowKitBox class methodsFor: 'displaying'! asCursor "return an image of the receiver which can be used as a cursor" ^self baseForm deepCopy! ! !FlowKitBox class methodsFor: 'instance creation'! offset: aPoint withName: aString withForm: aForm "create aType FoibleBox at aPoint with form aForm" | foibleBox | foibleBox _ super new. foibleBox initializeAt: aPoint withName: aString withForm: aForm. ^foibleBox! offset: aPoint withName: aString withForm: aForm superManager: aManager "create aType FoibleBox at aPoint with form aForm" | foibleBox | foibleBox _ super new. foibleBox initializeAt: aPoint withName: aString withForm: aForm superManager: aManager. ^foibleBox! ! !FlowKitBox class methodsFor: 'class initialization'! initialize "FlowKitBox initialize" StyleManager styleName: 'MagnoliaFixed6' baseNames: #('MagnoliaFixed6' ). SmallTextStyle _ StyleManager at: 'MagnoliaFixed6'! ! !FlowKitBox class methodsFor: 'form access'! iconDirectory "return the directory that contains the icons for the FlowKit" ^FlowKitDirectory iconDirectory! ! "FlowKitBox initialize"! FlowKitBox subclass: #BooleanBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! BooleanBox comment: 'BooleanBox is the abstract class for Boxes that provide boolean functions'! BooleanBox subclass: #AndBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! AndBox comment: 'AndBox is the concrete class for Boxes that perform the logical ''and'' function'! !AndBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 2 outputs: 1.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AndBox class instanceVariableNames: ''! !AndBox class methodsFor: 'class initialization'! initialize "AndBox initialize" formulas _ OrderedCollection with: [:a :b| a and: [b]]! ! AndBox initialize! BooleanBox subclass: #NotBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! NotBox comment: 'NotBox is the concrete class for Boxes that perform the logical ''not'' function'! !NotBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 1.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NotBox class instanceVariableNames: ''! !NotBox class methodsFor: 'class initialization'! initialize "NotBox initialize" formulas _ OrderedCollection with: [:a | a not]! ! NotBox initialize! BooleanBox subclass: #OrBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! OrBox comment: 'OrBox is the concrete class for Boxes that perform the logical ''or'' function'! !OrBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 2 outputs: 1.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OrBox class instanceVariableNames: ''! !OrBox class methodsFor: 'class initialization'! initialize "OrBox initialize" formulas _ OrderedCollection with: [:a :b| a or: [b]]! ! OrBox initialize! FlowKitBox subclass: #ComparisonBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ComparisonBox comment: 'ComparisonBox is the abstract class for Boxes that compare numbers'! ComparisonBox subclass: #NumericComparisonBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! NumericComparisonBox comment: 'NumericComparisonBox is the concrete class for Boxes that compare 2 numbers'! !NumericComparisonBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 2 outputs: 3.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NumericComparisonBox class instanceVariableNames: ''! !NumericComparisonBox class methodsFor: 'class initialization'! initialize "NumericComparisonBox initialize" formulas _ OrderedCollection with: [:a :b | a < b] with: [:a :b | a = b] with: [:a :b | a > b]! ! NumericComparisonBox initialize! ComparisonBox subclass: #ZeroComparisonBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ZeroComparisonBox comment: 'ZeroComparisonBox is the concrete class for Boxes that compare a number to zero'! !ZeroComparisonBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 3! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ZeroComparisonBox class instanceVariableNames: ''! !ZeroComparisonBox class methodsFor: 'class initialization'! initialize "ZeroComparisonBox initialize" formulas _ OrderedCollection with: [:a | a < 0] with: [:a | a = 0] with: [:a | a > 0]! ! ZeroComparisonBox initialize! FlowKitBox subclass: #ControlBox instanceVariableNames: 'manager ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ControlBox comment: 'ControlBox is the abstract class for Boxes that are control structures. '! !ControlBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" self value: self manager calculate. ^self value! ! !ControlBox methodsFor: 'manager access'! manager "return my companion manager" ^manager! newManager "return a manager of the type needed by the receiver" ^self defaultManagerClass newWithBox: self! ! !ControlBox methodsFor: 'initialization'! addSubBoxes "add the initial foible boxes needed for this ConStructBox" ^self subclassResponsibility! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint " " 10/89 added aManager, so that boxes can know their manager" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. manager _ self newManager. self addSubBoxes! initializePorts "initialize the ports of the FoibleBox" self inputs: 0 outputs: 0! ! !ControlBox methodsFor: 'displaying'! displayBox "return the area of the receiver that needs to be redrawn during calculations" ^self manager displayBox! ! !ControlBox methodsFor: 'comparing'! containsPoint: aPoint "ask the current manager to return the boxes that contain aPoint" | newBoxes | newBoxes _ self manager containsPoint: aPoint. newBoxes isEmpty ifTrue: [^super containsPoint: aPoint] ifFalse: [^newBoxes]! ! !ControlBox methodsFor: 'displaying-generic'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm "Ask the current manager to display its boxes" super displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm. "draw outline of box" self manager displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm! ! !ControlBox methodsFor: 'interface tests'! canBeDeleted "Return whether I can be deleted" ^self manager isEmpty! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ControlBox class instanceVariableNames: ''! !ControlBox class methodsFor: 'form access'! expandableForm "create the form for a ConStructBox" | aRectangle aForm | aRectangle _ Rectangle fromUser. aForm _ Form new. aForm extent: aRectangle extent offset: 0@0. aForm borderWidth: 1. Sensor cursorPoint: aRectangle origin. ^aForm! ! !ControlBox class methodsFor: 'displaying'! asCursor "return an image of the receiver which can be used as a cursor" ^self expandableForm deepCopy! ! ControlBox subclass: #ForLoopBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ForLoopBox comment: 'ForLoopBox is the concrete class for Boxes that behave as For Loops'! !ForLoopBox methodsFor: 'initialization'! addSubBoxes "add the initial foible boxes needed for this ControlBox" self manager addDecrementBox: self boundingBox. self manager addIncrementBox: self boundingBox! ! !ForLoopBox methodsFor: 'manager access'! defaultManagerClass "return a manager of the type needed by the receiver" ^ForLoopManager! ! ControlBox subclass: #WhileLoopBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! WhileLoopBox comment: 'WhileLoopBox is the concrete class for Boxes that behave as while loops'! !WhileLoopBox methodsFor: 'initialization'! addSubBoxes "add the initial foible boxes needed for this ControlBox" self manager addTestBox: self boundingBox. self manager addIncrementBox: self boundingBox! ! !WhileLoopBox methodsFor: 'manager access'! defaultManagerClass "return a manager of the type needed by the receiver" ^WhileLoopManager! ! FlowKitBox subclass: #FunctionBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FunctionBox comment: 'FunctionBox is the abstract class for Boxes that perform arithmetic functions'! !FunctionBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 2 outputs: 1.! ! FunctionBox subclass: #AdditionBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! AdditionBox comment: 'AdditionBox is the concrete class for Boxes that add numbers'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AdditionBox class instanceVariableNames: ''! !AdditionBox class methodsFor: 'class initialization'! initialize "AdditionBox initialize" formulas _ OrderedCollection with: [:a :b| a + b]! ! AdditionBox initialize! FunctionBox subclass: #IntegerDivisionBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! IntegerDivisionBox comment: 'IntegerDivisionBox is the concrete class for Boxes that perform integer division'! !IntegerDivisionBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 2 outputs: 2.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerDivisionBox class instanceVariableNames: ''! !IntegerDivisionBox class methodsFor: 'class initialization'! initialize "IntegerDivisionBox initialize" formulas _ OrderedCollection with: [:a :b | a rem: b] with: [:a :b | a quo: b]! ! IntegerDivisionBox initialize! FunctionBox subclass: #MaxBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! MaxBox comment: 'MaxBox is the concrete class for Boxes that perform the maximum function'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! MaxBox class instanceVariableNames: ''! !MaxBox class methodsFor: 'class initialization'! initialize "MaxBox initialize" formulas _ OrderedCollection with: [:a :b| a max: b]! ! MaxBox initialize! FunctionBox subclass: #MinBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! MinBox comment: 'MinBox is the concrete class for Boxes that perform the minimum function'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! MinBox class instanceVariableNames: ''! !MinBox class methodsFor: 'class initialization'! initialize "MinBox initialize" formulas _ OrderedCollection with: [:a :b| a min: b]! ! MinBox initialize! FunctionBox subclass: #MultiplicationBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! MultiplicationBox comment: 'MultiplicationBox is the concrete class for Boxes that multiply numbers'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! MultiplicationBox class instanceVariableNames: ''! !MultiplicationBox class methodsFor: 'class initialization'! initialize "MultiplicationBox initialize" formulas _ OrderedCollection with: [:a :b | a * b]! ! MultiplicationBox initialize! FunctionBox subclass: #RealDivisionBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! RealDivisionBox comment: 'RealDivisionBox is the concrete class for Boxes that perform real number division'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RealDivisionBox class instanceVariableNames: ''! !RealDivisionBox class methodsFor: 'class initialization'! initialize "RealDivisionBox initialize" formulas _ OrderedCollection with: [:a :b| a / b]! ! RealDivisionBox initialize! FunctionBox subclass: #SubtractionBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! SubtractionBox comment: 'SubtractionBox is the concrete class for Boxes that subtract numbers'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SubtractionBox class instanceVariableNames: ''! !SubtractionBox class methodsFor: 'class initialization'! initialize "SubtractionBox initialize" formulas _ OrderedCollection with: [:a :b | a - b]! ! SubtractionBox initialize! FlowKitBox subclass: #InputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! InputBox comment: 'InputBox is the abstract class for Boxes that accept user input'! !InputBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 0 outputs: 1! ! !InputBox methodsFor: 'calculations'! outputResults: results "display the results of the receiver's calculation, InputBox sends its single result to all of its Output Ports" self displayValue: results. (1 to: outputPort size) do: [:i | (outputPort at: i) token: (results at: 1)]! ! !InputBox methodsFor: 'port access'! findOutputPort: aPoint "find and return an output port that can be linked to at aPoint, InputBox can accept an infinite number of outgoing links" | newPort result ports aRectangle | result _ super findOutputPort: aPoint. result isNil ifTrue: [ports _ outputPort select: [:each | each boundingBox containsPoint: aPoint]. ports isEmpty ifTrue: [^nil] ifFalse: [newPort _ (ports at: 1) shallowCopy. newPort link: nil. outputPort add: newPort. ^newPort]] ifFalse: [^result]! ! !InputBox methodsFor: 'interface tests'! canAcceptInput "input boxes accept input by default" ^true! canBeCopied "Return whether I can be copied" ^false! ! InputBox subclass: #BooleanInputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !BooleanInputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self initValue: (OrderedCollection with: false)! ! !BooleanInputBox methodsFor: 'accessing'! acceptInput: aPoint "return opposite of current value" ^self value first not! firstValue: aValue "set the first value of the receiver" self value at: 1 put: aValue. self displayValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" self firstValue: aValue. ^self boundingBox! value: aValue "set the value of the receiver" value _ aValue. self displayValue! ! !BooleanInputBox methodsFor: 'form access'! addInput: aValue toForm: aForm "display aValue on aForm and return it" aValue ifTrue: [self class onButtonForm displayOn: aForm at: 0 @ 0. ^aForm] ifFalse: [^aForm].! inputForm "return a copy of the receiver's form with the current input displayed" | aForm | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: self firstValue toForm: aForm! inputForm: aValue "return a copy of the receiver's form with aValue displayed on it" | aForm | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: aValue toForm: aForm! ! !BooleanInputBox methodsFor: 'displaying'! displayValue "displays the receiver's current value" self removeAllForms. forms add: self inputForm! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanInputBox class instanceVariableNames: ''! !BooleanInputBox class methodsFor: 'accessing'! companionClass "return the class of my companion Box" ^DummyBooleanInputBox! ! BooleanInputBox subclass: #BooleanArrowsInput instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanArrowsInput class instanceVariableNames: 'onButtonForm '! !BooleanArrowsInput class methodsFor: 'class initialization'! initialize "BooleanArrowsInput initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanArrowsInput class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: 'BooleanArrows.on']. ^onButtonForm! ! !BooleanArrowsInput class methodsFor: 'form access'! baseForm "Return the form for this class" myForm isNil ifTrue: [myForm _ self getIcon: 'BooleanArrows']. ^myForm deepCopy! ! BooleanArrowsInput initialize! BooleanInputBox subclass: #BooleanHandInput instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanHandInput class instanceVariableNames: 'onButtonForm '! !BooleanHandInput class methodsFor: 'class initialization'! initialize "BooleanHandInput initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanHandInput class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: 'BooleanHand.on']. ^onButtonForm! ! !BooleanHandInput class methodsFor: 'form access'! baseForm "Return the form for this class" myForm isNil ifTrue: [myForm _ self getIcon: 'BooleanHand']. ^myForm deepCopy! ! BooleanHandInput initialize! BooleanInputBox subclass: #BooleanLightInput instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanLightInput class instanceVariableNames: 'onButtonForm '! !BooleanLightInput class methodsFor: 'class initialization'! initialize "BooleanLightInput initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanLightInput class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: 'BooleanLight.on']. ^onButtonForm! ! !BooleanLightInput class methodsFor: 'form access'! baseForm "Return the form for this class" myForm isNil ifTrue: [myForm _ self getIcon: 'BooleanLight']. ^myForm deepCopy! ! BooleanLightInput initialize! InputBox subclass: #DummyBooleanInputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !DummyBooleanInputBox methodsFor: 'calculations'! value "return the value of the receiver" ^self companion value! ! !DummyBooleanInputBox methodsFor: 'interface tests'! canAcceptInput "dummy input boxes don't allow input" ^false! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DummyBooleanInputBox class instanceVariableNames: ''! !DummyBooleanInputBox class methodsFor: 'class initialization'! initialize "DummyBooleanInputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! DummyBooleanInputBox initialize! InputBox subclass: #DummyNumericInputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! DummyNumericInputBox comment: 'DummyNumericInputBox is the concrete class for Boxes that serve as place markers in the back view for NumericInputBoxes'! !DummyNumericInputBox methodsFor: 'calculations'! value "return the value of the receiver" ^self companion value! ! !DummyNumericInputBox methodsFor: 'interface tests'! canAcceptInput "dummy input boxes don't allow input" ^false! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DummyNumericInputBox class instanceVariableNames: ''! !DummyNumericInputBox class methodsFor: 'class initialization'! initialize "StaticNumericInputBox initialize" formulas _ OrderedCollection with: [:box | box firstValue]! ! DummyNumericInputBox initialize! InputBox subclass: #NumericInputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! NumericInputBox comment: 'NumericInputBox is the concrete class for Boxes that accept numeric input from the user'! !NumericInputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self initValue: (OrderedCollection with: 0)! ! !NumericInputBox methodsFor: 'accessing'! firstValue: aValue "set the first value of the receiver" self value at: 1 put: aValue. self displayValue! initValue: aValue "store the receiver's initial value" self value: aValue. self displayValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" aValue size > 0 ifTrue: [self firstValue: aValue asNumber. ^self boundingBox] ifFalse: [^'Box must have a number, please try again']! value: aValue "set the value of the receiver" value _ aValue. self displayValue! ! !NumericInputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "display aValue on aForm and return it" "Write the number aNumber to aForm NOTE: Hard-coded routine: assumes 50x18 boxes" | aNumberString aString | aNumberString _ aNumber printString. (aNumberString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 4 @ 4. ^aForm! inputForm "return a copy of the receiver's form with the current input displayed" | aForm | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: self firstValue toForm: aForm! ! !NumericInputBox methodsFor: 'displaying'! displayValue "displays the receiver's current value" self removeAllForms. forms add: self inputForm! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NumericInputBox class instanceVariableNames: ''! !NumericInputBox class methodsFor: 'accessing'! companionClass "return the class of my companion Box" ^DummyNumericInputBox! ! !NumericInputBox class methodsFor: 'class initialization'! initialize "NumericInputBox initialize" formulas _ OrderedCollection with: [:box | box firstValue]! ! NumericInputBox initialize! NumericInputBox subclass: #DigitalTunerInputBox instanceVariableNames: 'increment ' classVariableNames: 'DecreaseRect IncreaseRect ' poolDictionaries: '' category: 'FlowKit'! !DigitalTunerInputBox methodsFor: 'interface tests'! canBeCalibrated "increment of digital tuner can be adjusted" ^true! ! !DigitalTunerInputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "display aValue on aForm and return it" | aNumberString aString | aNumberString _ aNumber printString. (aNumberString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 7 @ 15. ^aForm! ! !DigitalTunerInputBox methodsFor: 'accessing'! acceptInput: aPoint "increment or decrement the tuner if appropriate buttons are pressed" (DecreaseRect containsPoint: aPoint) ifTrue: [^self value first - self increment]. (IncreaseRect containsPoint: aPoint) ifTrue: [^self value first + self increment]. ^self value first! calibrate "allow user to set tuner increment" | newIncrement | newIncrement _ FillInTheBlank request: 'Enter increment for tuner:' initialAnswer: self increment printString. self increment: newIncrement asNumber! increment "return the current tuner increment" ^increment! increment: aValue "set the current tuner increment" increment _ aValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" self firstValue: aValue. ^self boundingBox! ! !DigitalTunerInputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" self initializeIncrement. super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager! initializeIncrement "initialize the tuning increment" increment _ 1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DigitalTunerInputBox class instanceVariableNames: ''! !DigitalTunerInputBox class methodsFor: 'class initialization'! initialize "DigitalTunerInputBox initialize" DecreaseRect _ Rectangle origin: 4 @ 30 corner: 24 @ 42. IncreaseRect _ Rectangle origin: 27 @ 30 corner: 47 @ 42. formulas _ OrderedCollection with: [:box | box firstValue]! ! DigitalTunerInputBox initialize! NumericInputBox subclass: #RandomNumberInputBox instanceVariableNames: 'rand max ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !RandomNumberInputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self initializeStream. self initValue: (OrderedCollection with: (self acceptInput: 0@0))! initializeStream "create a Random stream for the input box and set initial maximum" rand _ Random new. max _ 50! ! !RandomNumberInputBox methodsFor: 'accessing'! acceptInput: aPoint "get the next number in the random stream" ^(self rand next * max) truncated + 1! calibrate "allow user to set the maximum value for the random number" | newMax | newMax _ FillInTheBlank request: 'Enter maximum random value:' initialAnswer: self max printString. self max: newMax asNumber! max "get the upper limit for this random box" ^max! max: aValue "set the upper limit for this random box" max _ aValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" self firstValue: aValue. ^self boundingBox! rand "return the stream for this instance" ^rand! ! !RandomNumberInputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "display aValue on aForm and return it" | aNumberString aString | aNumberString _ aNumber printString. (aNumberString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 7 @ 37. ^aForm! ! !RandomNumberInputBox methodsFor: 'interface tests'! canBeCalibrated "max of random number box can be adjusted" ^true! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RandomNumberInputBox class instanceVariableNames: ''! !RandomNumberInputBox class methodsFor: 'class initialization'! initialize "RandomNumberInputBox initialize" formulas _ OrderedCollection with: [:box | box firstValue]! ! RandomNumberInputBox initialize! NumericInputBox subclass: #SliderInputBox instanceVariableNames: 'min max increment knobForm knobPosition prevXValue ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !SliderInputBox methodsFor: 'interface tests'! canBeCalibrated "max and min of slider can be adjusted" ^true! ! !SliderInputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "display aValue on aForm and return it" | aNumberString aString | aNumberString _ aNumber printString. (aNumberString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 5 @ 112. self knob displayOn: aForm at: self knobPosition. "self knob moveTo: self knobPosition + (aForm offset) restoring: aForm. <-- doesn't work" ^aForm! ! !SliderInputBox methodsFor: 'private'! adjustKnobPosition "reset the position of the slider knob" | knobLocation range | knobLocation _ (self value first - self min) abs. range _ self max - self min. knobLocation _ (knobLocation / range * 100 asFloat) rounded. (self value first >= self max or: [knobLocation > 100]) ifTrue: [knobLocation _ 100. self value at: 1 put: self max]. self value first <= self min ifTrue: [knobLocation _ 0. self value at: 1 put: self min]. knobLocation _ 100 - knobLocation. knobPosition y: knobLocation! canDecrease "answer true if not at minimum" self value first <= self min ifTrue: [^false]. ^true! canIncrease "answer true if not at maximum" self value first >= self max ifTrue: [^false]. ^true! changeKnobPositionBy: aValue "set the position of the slider knob" | oldY newY | oldY _ knobPosition y. newY _ oldY + aValue. knobPosition y: newY! ! !SliderInputBox methodsFor: 'accessing'! acceptInput: aPoint | knobRect | knobRect _ Rectangle origin: self knobPosition extent: 15 @ 15. (knobRect containsPoint: aPoint) ifTrue: [prevXValue > aPoint x & self canDecrease ifTrue: [self changeKnobPositionBy: 2. ^self value first + self increment negated] ifFalse: [prevXValue < aPoint x & self canIncrease ifTrue: [self changeKnobPositionBy: -2. ^self value first + self increment]]]. prevXValue _ aPoint x. ^self value first! calibrate "allow user to set the maximum and minimum values for the slider" | newMax newMin newRange | newMin _ FillInTheBlank request: 'Enter minimum for device:' initialAnswer: self min printString. self min: newMin asNumber. newMax _ FillInTheBlank request: 'Enter maximum for device:' initialAnswer: self max printString. self max: newMax asNumber. newRange _ self max - self min. self increment: (newRange / 50) asFloat. self adjustKnobPosition! increment "answer the current slider increment" ^increment! increment: aValue "set the current slider increment" increment _ aValue! knob "answer the form of the slider knob" ^knobForm! knobPosition "answer the position of the slider knob" ^knobPosition! knobPosition: aPoint "set the position of the slider knob" knobPosition _ aPoint! max "answer the slider maximum" ^max! max: aValue "set the slider maximum" max _ aValue! min "answer the slider minimum" ^min! min: aValue "set the slider minimum" min _ aValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" self firstValue: aValue. ^self boundingBox! ! !SliderInputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" self initializeSlider. super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager! initializeSlider "initialize the slider variables" self max: 50. self min: 0. self increment: 1. prevXValue _ 100. knobForm _ Form extent: 12@7. knobForm borderWidth: 2 mask: Form black. knobPosition _ 18 @ 100! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SliderInputBox class instanceVariableNames: ''! !SliderInputBox class methodsFor: 'class initialization'! initialize "SliderInputBox initialize" formulas _ OrderedCollection with: [:box | box firstValue]! ! SliderInputBox initialize! FlowKitBox subclass: #LabelBox instanceVariableNames: 'label ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! LabelBox comment: 'LabelBox is the concrete class for Boxes that serve as labels The instance variable label holds the label of the LabelBox'! !LabelBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self initValue: (OrderedCollection with: '')! initializePorts "initialize the ports of the FoibleBox" self inputs: 0 outputs: 0! ! !LabelBox methodsFor: 'accessing'! firstValue: aValue "set the first value of the receiver" self value at: 1 put: aValue. self displayValue! initValue: aValue "store the receiver's initial value" self value: aValue. self displayValue! newInputFromUser: aValue "inform the receiver that he has new input from the user" self firstValue: aValue. ^self boundingBox! value: aValue "set the value of the receiver" value _ aValue. self displayValue! ! !LabelBox methodsFor: 'displaying'! displayValue "display the label string of the receiver" self removeAllForms. forms add: self inputForm! ! !LabelBox methodsFor: 'form access'! addInput: aString toForm: aForm "Write the string aString to aForm NOTE: Hard-coded routine: assumes 50x18 boxes, Manolia 6 font" (aString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 2 @ 4. ^aForm! inputForm "Return a copy of the receiver's form with the current label string displayed" | aForm aText | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: self firstValue toForm: aForm! ! !LabelBox methodsFor: 'interface tests'! canAcceptInput "label boxes accept input" ^true! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! LabelBox class instanceVariableNames: ''! !LabelBox class methodsFor: 'displaying'! asCursor "return an image of the receiver which can be used as a cursor" ^self expandableForm deepCopy! ! !LabelBox class methodsFor: 'form access'! expandableForm "create the form for a ConStructBox" | aRectangle aForm | aRectangle _ Rectangle fromUser. aForm _ Form new. aForm extent: aRectangle extent offset: 0@0. aForm borderWidth: 1. Sensor cursorPoint: aRectangle origin. ^aForm! ! FlowKitBox subclass: #LoopControlBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! LoopControlBox comment: 'LoopControlBox is the abstract class for Boxes that behave as loop control variables for ControlBoxes'! !LoopControlBox methodsFor: 'calculations'! masterCalculateValue: someValues "calculate the receiver's value given the input someValues" self subclassResponsibility! masterToken "the sender, an input port, has received a new value for use in the receiver's calculation" | values results | values _ self getInputValues. values isNil ifTrue: [^nil]. results _ self masterCalculateValue: values. self outputResults: results! ! !LoopControlBox methodsFor: 'interface tests'! canBeDeleted "Return whether I can be deleted" ^false! canMoveIndependently "Return whether I can move at the user's request" ^false! ! LoopControlBox subclass: #DecrementBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! DecrementBox comment: 'DecrementBox is the concrete class for Boxes that serve as counter variables for ForLoopBoxes, counting down to zero'! !DecrementBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 1.! ! !DecrementBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" self value isNil ifTrue: [self value: someValues]. ^self value! masterCalculateValue: someValues "calculate the receiver's value given the input someValues" self firstValue: self firstValue - 1. ^self value! ! LoopControlBox subclass: #IncrementBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! IncrementBox comment: 'IncrementBox is the concrete class for Boxes that serve as counter variables for ControlBoxes, counting up from zero'! !IncrementBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 0 outputs: 1.! ! !IncrementBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" self value isNil ifTrue: [self value: (OrderedCollection with: 0)]. ^self value! masterCalculateValue: someValues "calculate the receiver's value given the input someValues" self firstValue: self firstValue + 1. ^self value! ! LoopControlBox subclass: #ShiftRegBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ShiftRegBox comment: 'ShiftRegBox is the abstract class for Shift Register Boxes'! !ShiftRegBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ShiftRegBox class instanceVariableNames: ''! !ShiftRegBox class methodsFor: 'form access'! baseForm "Return the form for this class" myForm isNil ifTrue: [myForm _ self getIcon: 'ShiftRegBox']. ^myForm deepCopy! ! ShiftRegBox subclass: #LeftShiftRegBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! LeftShiftRegBox comment: 'LeftShiftRegBox is the concrete class for Shift Register Boxes that reside on the left side of ControlBoxes '! !LeftShiftRegBox methodsFor: 'calculations'! masterCalculateValue: someValues "calculate the receiver's value given the input someValues" self value: someValues. ^self value! token "the sender, an input port, has received a new value for use in the receiver's calculation" "ignore this message" ^self! ! ShiftRegBox subclass: #RightShiftRegBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! RightShiftRegBox comment: 'LeftShiftRegBox is the concrete class for Shift Register Boxes that reside on the left side of ControlBoxes '! !RightShiftRegBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" self value isNil ifTrue: [self value: someValues]. ^self value! masterCalculateValue: someValues "calculate the receiver's value given the input someValues" | aValue | companion masterToken. aValue _ companion value. aValue isNil ifFalse: [self value: companion value]. ^self value! ! LoopControlBox subclass: #TestBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! TestBox comment: 'TestBox is the concrete class for Boxes that serve as the boolean test variables that provide loop control for WhileLoopBoxes'! !TestBox methodsFor: 'calculations'! calculateValue: someValues "calculate the receiver's value given the input someValues" self value: someValues. ^self value! ! !TestBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 1! ! FlowKitBox subclass: #OutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! OutputBox comment: 'OutputBox is the abstract class for Boxes that display values'! !OutputBox methodsFor: 'initialization'! initializePorts "initialize the ports of the FoibleBox" self inputs: 1 outputs: 1.! ! !OutputBox methodsFor: 'displaying'! displayBox "returns the area of the receiver to redisplay to reflect the current calculations" ^self boundingBox! ! !OutputBox methodsFor: 'calculations'! outputResults: results "display the results of the receiver's calculation, OutputBox sends its single result to all of its Output Ports" self displayValue: results. (1 to: outputPort size) do: [:i | (outputPort at: i) token: (results at: 1)]! ! !OutputBox methodsFor: 'port access'! findOutputPort: aPoint "find and return an output port that can be linked to at aPoint, OutputBox can accept an infinite number of outgoing links" | newPort result ports aRectangle | result _ super findOutputPort: aPoint. result isNil ifTrue: [ports _ outputPort select: [:each | each boundingBox containsPoint: aPoint]. ports isEmpty ifTrue: [^nil] ifFalse: [newPort _ (ports at: 1) shallowCopy. newPort link: nil. outputPort add: newPort. ^newPort]] ifFalse: [^result]! ! !OutputBox methodsFor: 'interface tests'! canBeCopied "Return whether I can be copied" ^false! ! OutputBox subclass: #BooleanOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! BooleanOutputBox comment: 'BooleanOutputBox is an abstract class for Boxes that display boolean values. Concrete classes must provide an initialization message to set up the initial and "on" forms. '! !BooleanOutputBox methodsFor: 'displaying'! displayValue: someValues "display the value of a Boolean Output Box during calculations " self removeAllForms. forms add: (self inputForm: (someValues at: 1))! ! !BooleanOutputBox methodsFor: 'form access'! addInput: aValue toForm: aForm "display aValue on aForm and return it" aValue ifTrue: [self class onButtonForm displayOn: aForm at: 0 @ 0. ^aForm] ifFalse: [^aForm]! inputForm: aValue "return a copy of the receiver's form with aValue displayed on it" | aForm aText | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: aValue toForm: aForm! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanOutputBox class instanceVariableNames: ''! BooleanOutputBox class comment: 'The class instance variable onButtonForm holds the form that is displayed when the BooleanOutputBox has a true value'! !BooleanOutputBox class methodsFor: 'accessing'! companionClass "return the class of my companion Box" ^DummyBooleanOutputBox! ! BooleanOutputBox subclass: #BooleanArrows instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanArrows class instanceVariableNames: 'onButtonForm '! !BooleanArrows class methodsFor: 'class initialization'! initialize "BooleanArrows initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanArrows class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: self name,'.on']. ^onButtonForm! ! BooleanArrows initialize! BooleanOutputBox subclass: #BooleanHand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanHand class instanceVariableNames: 'onButtonForm '! !BooleanHand class methodsFor: 'class initialization'! initialize "BooleanHand initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanHand class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: self name,'.on']. ^onButtonForm! ! BooleanHand initialize! BooleanOutputBox subclass: #BooleanLight instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BooleanLight class instanceVariableNames: 'onButtonForm '! !BooleanLight class methodsFor: 'class initialization'! initialize "BooleanLight initialize" formulas _ OrderedCollection with: [:value | value]! ! !BooleanLight class methodsFor: 'accessing'! onButtonForm "return the on form class instance variable" onButtonForm isNil ifTrue: [onButtonForm _ self getIcon: self name,'.on']. ^onButtonForm! ! BooleanLight initialize! OutputBox subclass: #DummyBooleanOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! DummyBooleanOutputBox comment: 'DummyBooleanOutputBox is the concrete class for Boxes that serve as place markers in the back view for BooleanOutputBoxes'! !DummyBooleanOutputBox methodsFor: 'calculations'! token "the sender, an input port, has received a new value for use in the receiver's calculation and the receiver's companion " super token. self companion displayValue: self value! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DummyBooleanOutputBox class instanceVariableNames: ''! !DummyBooleanOutputBox class methodsFor: 'class initialization'! initialize "DummyBooleanOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! DummyBooleanOutputBox initialize! OutputBox subclass: #DummyNumericOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! DummyNumericOutputBox comment: 'DummyNumericOutputBox is the concrete class for Boxes that serve as place markers in the back view for NumericOutputBoxes'! !DummyNumericOutputBox methodsFor: 'calculations'! token "the sender, an input port, has received a new value for use in the receiver's calculation and the receiver's companion " super token. self companion displayValue: self value! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DummyNumericOutputBox class instanceVariableNames: ''! !DummyNumericOutputBox class methodsFor: 'class initialization'! initialize "StaticNumericOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! DummyNumericOutputBox initialize! OutputBox subclass: #NumericOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! NumericOutputBox comment: 'NumericOutputBox is the concrete class for Boxes that display numbers'! !NumericOutputBox methodsFor: 'displaying'! displayValue: someNumbers "display the value of a Numeric Output Box during calculations" self removeAllForms. forms add: (self inputForm: (someNumbers at: 1))! ! !NumericOutputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "display aValue on aForm and return it" "Write the number aNumber to aForm NOTE: Hard-coded routine: assumes 50x18 boxes, Manolia 6 font" | aNumberString aString | aNumberString _ aNumber printString. (aNumberString asDisplayText textStyle: SmallTextStyle) displayOn: aForm at: 4 @ 4. ^aForm! inputForm: aNumber "return a copy of the receiver's form with aNumber displayed on it" | aForm aText | aForm _ self baseForm. aForm offset: 0@0. ^self addInput: aNumber toForm: aForm! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NumericOutputBox class instanceVariableNames: ''! !NumericOutputBox class methodsFor: 'class initialization'! initialize "NumericOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! !NumericOutputBox class methodsFor: 'accessing'! companionClass "return the class of my companion Box" ^DummyNumericOutputBox! ! NumericOutputBox initialize! NumericOutputBox subclass: #ScaledNumericOutputBox instanceVariableNames: 'max min ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !ScaledNumericOutputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self initializeRange! initializeRange "initialize the max and min of the output device" self max: 100. self min: 0! ! !ScaledNumericOutputBox methodsFor: 'accessing'! calibrate "allow user to set the maximum and minimum values for the output device" | newMax newMin | newMin _ FillInTheBlank request: 'Enter minimum for device:' initialAnswer: self min printString. self min: newMin asNumber. newMax _ FillInTheBlank request: 'Enter maximum for device:' initialAnswer: self max printString. self max: newMax asNumber! max "get the upper limit for this device" ^max! max: aValue "set the upper limit for this device" max _ aValue! min "get the lower limit for this device" ^min! min: aValue "set the lower limit for this device" min _ aValue! ! !ScaledNumericOutputBox methodsFor: 'interface tests'! canBeCalibrated "max and min of scaled devices can be adjusted" ^true! ! !ScaledNumericOutputBox methodsFor: 'scaling'! scaleNumericValue: aNumber "answer a value scaled for display" self subclassResponsibility! ! ScaledNumericOutputBox subclass: #AnalogMeterOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !AnalogMeterOutputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "convert the output to number for display" | pos aLine x y | pos _ self scaleNumericValue: aNumber. x _ (pos * 6 - 135) degreesToRadians cos. y _ (pos * 6 - 135) degreesToRadians sin. aLine _ Line from: 0 @ 0 to: x @ y * 35 withForm: (Form dotOfSize: 2). aLine displayOn: aForm at: 30 @ 52. ^aForm! ! !AnalogMeterOutputBox methodsFor: 'scaling'! scaleNumericValue: aNumber "answer the position of the meter hand as a number between 1 and 15" | range adjustedNumber | aNumber < self min ifTrue: [^0] ifFalse: [adjustedNumber _ (aNumber - self min) abs. range _ self max - self min. ^15 min: (adjustedNumber / range * 15 asFloat) rounded]! ! !AnalogMeterOutputBox methodsFor: 'initialization'! initializeAt: aPoint withName: aName withForm: aForm superManager: aManager "initialize the new FoibleBox at aPoint" super initializeAt: aPoint withName: aName withForm: aForm superManager: aManager. self displayValue: (OrderedCollection with: 1).! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AnalogMeterOutputBox class instanceVariableNames: ''! !AnalogMeterOutputBox class methodsFor: 'class initialization'! initialize "AnalogMeterOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! AnalogMeterOutputBox initialize! ScaledNumericOutputBox subclass: #LEDMeterOutputBox instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !LEDMeterOutputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "convert the output to number of LEDs and light that number " | leds aRect | leds _ self scaleNumericValue: aNumber. aRect _ Rectangle origin: (9 @ 21) extent: 8 @ 9. 1 to: 10 do: [:x | x <= leds ifTrue: [aForm fill: aRect mask: Form darkGray] ifFalse: [aForm fill: aRect mask: Form white]. aRect moveBy: 10 @ 0]. ^aForm! ! !LEDMeterOutputBox methodsFor: 'scaling'! scaleNumericValue: aNumber "answer the number of LEDs to light" | range adjustedNumber | aNumber < self min ifTrue: [^0] ifFalse: [adjustedNumber _ (aNumber - self min) abs. range _ self max - self min. ^(adjustedNumber / range * 10 asFloat) rounded]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! LEDMeterOutputBox class instanceVariableNames: ''! !LEDMeterOutputBox class methodsFor: 'class initialization'! initialize "LEDMeterOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! LEDMeterOutputBox initialize! ScaledNumericOutputBox subclass: #PlottedOutputBox instanceVariableNames: 'plotQueue ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !PlottedOutputBox methodsFor: 'form access'! addInput: aNumber toForm: aForm "convert the output to new point on plot, display plot queue of values" | newValue aLinearFit position plotForm | self addToPlotQueue: aNumber. plotForm _ Form new extent: 2 @ 2. plotForm black. aLinearFit _ LinearFit new. aLinearFit form: plotForm. position _ 0. plotQueue do: [:x | (x notNil) ifTrue: [newValue _ self scaleNumericValue: x]. aLinearFit add: position @ newValue. position _ position + 15]. aLinearFit displayOn: aForm at: 0 @ 0. ^aForm! ! !PlottedOutputBox methodsFor: 'scaling'! scaleNumericValue: aNumber "answer a value between 1 and 80" | range adjustedNumber | aNumber < self min ifTrue: [^0] ifFalse: [adjustedNumber _ (aNumber - self min) abs. range _ self max - self min. ^80 - (adjustedNumber / range * 80 asFloat) rounded]! ! !PlottedOutputBox methodsFor: 'private'! addToPlotQueue: aNumber "add the new value to the plot queue" plotQueue add: aNumber. plotQueue size > 11 ifTrue: [plotQueue removeFirst]! ! !PlottedOutputBox methodsFor: 'initialization'! initializeRange "initialize the max and min of the output device" self max: 100. self min: 0. plotQueue _ OrderedCollection new: 1. plotQueue add: 50! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PlottedOutputBox class instanceVariableNames: ''! !PlottedOutputBox class methodsFor: 'class initialization'! initialize "PlottedOutputBox initialize" formulas _ OrderedCollection with: [:value | value]! ! PlottedOutputBox initialize! FoibleLink subclass: #WiringLink instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! WiringLink comment: 'WiringLink is the concrete class of all Links in FlowKit'! !WiringLink methodsFor: 'interface tests'! acceptsDataLinks: aPoint "Return whether I accept DataLinks at the user interface" ^false! canAcceptInput "just say no to input requests for wires" ^false! canMoveDependently "Return whether I can be moved when I am in a Control box being moved" ^false! givesDataLinks: aPoint "Return whether I give DataLinks at the user interface" ^false! ! !WiringLink methodsFor: 'calculations'! initValue: aValue "ignore this message, it is for boxes only" ^self! token: aValue "the receiver has a new value, pass the value to its destination port" destination token: aValue! ! !WiringLink methodsFor: 'accessing'! companion "ignore this message, it is for boxes only" ^nil! ! !WiringLink methodsFor: 'displaying'! displayBox "answers nil, indicating the receiver does not display its value during calculations" ^nil! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WiringLink class instanceVariableNames: ''! !WiringLink class methodsFor: 'form access'! iconDirectory "return the directory that contains the icons for the FlowKit" ^FlowKitDirectory iconDirectory! ! FoibleManager subclass: #FlowKitManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FlowKitManager comment: 'FlowKitManager is the concrete class for managers'! !FlowKitManager methodsFor: 'accessing'! changeValue: name to: newInput "Inform the Box with the given name that it has new input" | box | box _ self findName: name. box isNil ifTrue: [^nil]. ^box newInputFromUser: newInput! lastBox "returns the last box added to to the receiver" ^boxes last! ! !FlowKitManager methodsFor: 'displaying'! displayBox "returns the area of the manager's box that needs to be redrawn during calculations" | aBox aRectangle | boxes do: [:each | aBox _ each displayBox. aRectangle isNil ifTrue: [aRectangle _ aBox] ifFalse: [aBox isNil ifFalse: [aRectangle _ aRectangle merge: aBox]]]. ^aRectangle! ! !FlowKitManager methodsFor: 'calculations'! calculate "start calculations of all of the receiver's boxes" boxes do: [:each | (each isKindOf: InputBox) ifTrue: [each token]]. boxes do: [:each | (each isKindOf: ControlBox) ifTrue: [each token]]. ^nil! ! !FlowKitManager methodsFor: 'adding'! add: aClass at: aPoint "add a Foible of the class aClass at aPoint" ^self addBox: [:name | aClass offset: aPoint withName: name withForm: aClass asCursor superManager: self]! ! FlowKitManager subclass: #ControlBoxManager instanceVariableNames: 'inputs leftShiftReg rightShiftReg incrementBox ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ControlBoxManager comment: 'ControlBoxManager is the concrete class for managers of ControlBoxes. Instance Variables: inputs is a collection of boxes that must have input before a ControlBoxManager can execute its subprogram leftShiftReg and rightShiftReg are collections, respectively, of leftShiftRegBoxes and rightShiftRegBoxes in the ControlBoxManager''s subprogram incrementBox is the ''i'' box in the ControlBoxManager''s subprogram '! !ControlBoxManager methodsFor: 'accessing'! addInput: aBox "add aBox to the set of inputs of the receiver" inputs isNil ifTrue: [inputs _ OrderedCollection new]. inputs add: aBox! inputs "return the collection of inputs for this box" ^inputs! ! !ControlBoxManager methodsFor: 'adding'! addIncrementBox: aRectangle "add increment box" incrementBox _ IncrementBox offset: aRectangle origin + (aRectangle extent x // 8 @ (3 * (aRectangle extent y // 4))) withName: 'i' withForm: IncrementBox asCursor superManager: self. incrementBox initializePorts. boxes add: incrementBox! addShiftRegTo: aRectangle "add a shift register in the area aRectangle" | left right leftNum rightNum newLeftShiftReg newRightShiftReg name stream | leftShiftReg isNil ifTrue: [leftShiftReg _ OrderedCollection new]. rightShiftReg isNil ifTrue: [rightShiftReg _ OrderedCollection new]. leftNum _ 20 * leftShiftReg size. rightNum _ 20 * rightShiftReg size. left _ aRectangle origin + (0 @ (aRectangle extent y // 8 + leftNum)). right _ aRectangle origin + (14 * (aRectangle extent x // 15) @ (aRectangle extent y // 8 + rightNum)). name _ 'l' , '#############'. stream _ WriteStream on: name from: 2 to: name size. leftShiftReg size printOn: stream. name _ name copyUpTo: $#. newLeftShiftReg _ LeftShiftRegBox offset: left withName: name withForm: LeftShiftRegBox asCursor superManager: self. leftShiftReg add: newLeftShiftReg. newLeftShiftReg initializePorts. boxes add: newLeftShiftReg. name _ 'r' , '#############'. stream _ WriteStream on: name from: 2 to: name size. rightShiftReg size printOn: stream. name _ name copyUpTo: $#. newRightShiftReg _ RightShiftRegBox offset: right withName: name withForm: RightShiftRegBox asCursor superManager: self. rightShiftReg add: newRightShiftReg. newRightShiftReg initializePorts. boxes add: newRightShiftReg. self addInput: newRightShiftReg. newLeftShiftReg companion: newRightShiftReg. newRightShiftReg companion: newLeftShiftReg. ^newLeftShiftReg boundingBox merge: newRightShiftReg boundingBox! ! !ControlBoxManager methodsFor: 'calculations'! calcLoopControlBoxes "send masterTokens to loop control boxes to update their values " self subclassResponsibility! calculate "execute the subprogram of this ControlBoxManager" inputs isNil ifFalse: [inputs do: [:each | each value isNil ifTrue: [^nil]]]. boxes do: [:each | each initValue: nil]. self initLoopControlBoxes. super calculate. [self loopTest] whileTrue: [self calcLoopControlBoxes. super calculate]. ^self loopValue! initLoopControlBoxes "send tokens to loop control boxes to initialize their values" self subclassResponsibility! loopTest "test for the end of execution of the loop" self subclassResponsibility! loopValue "return the final value of the loop" self subclassResponsibility! ! ControlBoxManager subclass: #ForLoopManager instanceVariableNames: 'decrementBox ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ForLoopManager comment: 'ForLoopManager is the concrete class for managers of the subprograms of ForLoopBoxes The instance variable decrementBox is the ''N'' Box in the ForLoopManager''s subprogram '! !ForLoopManager methodsFor: 'calculations'! calcLoopControlBoxes "send masterTokens to loop control boxes to update their values" rightShiftReg isNil ifFalse: [rightShiftReg do: [:each | each masterToken]]. incrementBox masterToken. decrementBox masterToken! initLoopControlBoxes "send tokens to loop control boxes to initialize their values" rightShiftReg isNil ifFalse: [rightShiftReg do: [:each | each token]]. decrementBox token. incrementBox token! loopTest "test for the end of execution of the loop" ^decrementBox firstValue > 0! loopValue "return the final value of the loop" ^incrementBox value! ! !ForLoopManager methodsFor: 'adding'! addDecrementBox: aRectangle "add decrement box" decrementBox _ DecrementBox offset: aRectangle origin + (aRectangle extent x // 8 @ (aRectangle extent y // 8)) withName: 'N' withForm: DecrementBox asCursor superManager: self. decrementBox initializePorts. boxes add: decrementBox. self addInput: decrementBox.! ! !ForLoopManager methodsFor: 'accessing'! isEmpty "Return whether there is anything in this manager besides the loop control boxes" ^boxes size = (2 + leftShiftReg size + rightShiftReg size)! ! ControlBoxManager subclass: #WhileLoopManager instanceVariableNames: 'testBox ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! WhileLoopManager comment: 'WhileLoopManager is the concrete class for managers of the subprograms of WhileLoopBoxes The instance variable testBox holds the boolean test Box in the WhileLoopManager''s subprogram'! !WhileLoopManager methodsFor: 'calculations'! calcLoopControlBoxes "send masterTokens to loop control boxes to update their values" rightShiftReg isNil ifFalse: [rightShiftReg do: [:each | each masterToken]]. incrementBox masterToken! initLoopControlBoxes "send tokens to loop control boxes to initialize their values" rightShiftReg isNil ifFalse: [rightShiftReg do: [:each | each token]]. incrementBox token! loopTest "test for the end of execution of the loop" testBox value isNil ifTrue: [^false] ifFalse: [^testBox firstValue]! loopValue "return the final value of the loop" ^false! ! !WhileLoopManager methodsFor: 'adding'! addTestBox: aRectangle "add test box" testBox _ TestBox offset: aRectangle origin + (3 * (aRectangle extent x // 4) @ (3 * (aRectangle extent y // 4))) withName: '?' withForm: TestBox asCursor superManager: self. testBox initializePorts. boxes add: testBox! ! !WhileLoopManager methodsFor: 'accessing'! isEmpty "Return whether there is anything in this FoibleManager besides the loop control boxes" ^boxes size = (2 + leftShiftReg size + rightShiftReg size)! ! Object subclass: #FlowKitDirectory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FlowKitDirectory class instanceVariableNames: ''! !FlowKitDirectory class methodsFor: 'form access'! iconDirectory "return the directory that contains the icons for the FlowKit" ^'/jindrich/icons'! ! InputPort subclass: #FlowKitInputPort instanceVariableNames: 'value ' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FlowKitInputPort comment: 'FlowKitInputPort is the concrete class for Input Ports The instance variable value holds the value of the FlowKitInputPort'! !FlowKitInputPort methodsFor: 'accessing'! value "return the value of the receiver" ^value! ! !FlowKitInputPort methodsFor: 'calculations'! token: aValue "the sender has a new value for use in the receiver's box's calculation" value _ aValue. box token! ! OutputPort subclass: #FlowKitOutputPort instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FlowKitOutputPort comment: 'FlowKitOutputPort is the concrete class for Output Ports'! !FlowKitOutputPort methodsFor: 'calculations'! token: aValue "the receiver has a new value, pass the value to its link" link isNil ifFalse: [(1 to: link size) do: [:i | (link at: i) token: aValue]] "ifFalse: [link token: aValue]"! ! Tool subclass: #FlowKitTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FlowKitTool comment: 'FlowKitTool is the abstract class for all Tools in FlowKit'! !FlowKitTool methodsFor: 'menu messages'! add: aClass "Get a point in the viewport and add a Foible of the class aClass there" | aPoint aThing aBox currentModel aCursor | currentModel _ model. aCursor _ aClass asCursor. aPoint _ self getThingPoint: aCursor. aPoint isNil ifTrue: [^nil]. currentModel _ self getManager: aPoint. currentModel isNil ifTrue: [^nil]. aThing _ currentModel addBox: [:name | aClass offset: aPoint withName: name withForm: aCursor superManager: currentModel]. model changed: aThing! add: aClass withForm: aForm "Get a point in the viewport and add a Foible of the class aClass there. Then reset the permanent form" | aPoint aThing aBox currentModel aCursor | currentModel _ model. aCursor _ aForm. aPoint _ self getThingPoint: aCursor. aPoint isNil ifTrue: [^nil]. currentModel _ self getManager: aPoint. currentModel isNil ifTrue: [^nil]. aThing _ currentModel addBox: [:name | aClass offset: aPoint withName: name withForm: aCursor]. currentModel lastBox permanentForm: aClass asCursor. model changed: aThing! addWithCompanion: aClass "add a Box of class aClass and a companion Box for it in the other view" | otherModel otherView aPoint aBox aRectangle boxManager | otherView _ self otherView. otherModel _ otherView model. aPoint _ otherView boundingBox center. aBox _ otherModel find: aPoint. aBox isNil ifFalse: [boxManager _ aBox manager]. boxManager isNil ifTrue: [boxManager _ otherModel]. self add: aClass. aRectangle _ boxManager add: aClass companionClass at: aPoint. otherModel changed: aRectangle. boxManager lastBox companion: model lastBox. model lastBox companion: boxManager lastBox! getManager: aPoint "return the manager of the box at aPoint" | aBox | aBox _ model find: aPoint. aBox isNil ifTrue: [^model] ifFalse: [^aBox manager]! ! !FlowKitTool methodsFor: 'subview access'! otherView "it returns the other subview of the receiver's view's superview " ^view superView otherView: view! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FlowKitTool class instanceVariableNames: ''! !FlowKitTool class methodsFor: 'form access'! iconDirectory "return the directory that contains the icons for FlowKit" ^FlowKitDirectory iconDirectory! ! FlowKitTool subclass: #BooleanTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! BooleanTool comment: 'BooleanTool is the concrete class for Tools that add Boxes that inherit from BooleanBox'! !BooleanTool methodsFor: 'menu messages'! andBox self add: AndBox! notBox self add: NotBox! orBox self add: OrBox! ! !BooleanTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'invert and or') yellowButtonMessages: #(notBox andBox orBox)! ! FlowKitTool subclass: #ComparisonTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ComparisonTool comment: 'ComparisonTool is the concrete class for Tools that add Boxes that inherit from ComparisonBox'! !ComparisonTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'numeric comparison zero comparison') yellowButtonMessages: #(numericComparisonBox zeroComparisonBox)! ! !ComparisonTool methodsFor: 'menu messages'! numericComparisonBox self add: NumericComparisonBox! zeroComparisonBox self add: ZeroComparisonBox! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ComparisonTool class instanceVariableNames: ''! !ComparisonTool class methodsFor: 'accessing'! cursorOffset "Return the offset of my cursor" ^-8 @ -9! ! FlowKitTool subclass: #ControlTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! ControlTool comment: 'ControlTool is the concrete class for Tools that add Boxes that inherit from ControlBox'! !ControlTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'while loop for loop shift register') yellowButtonMessages: #(whileLoop forLoop addShiftReg )! ! !ControlTool methodsFor: 'menu messages'! addShiftReg "Get a ControlBox and add a pair of shift registers there" | aBox aPoint currentModel aThing | aPoint _ self getPoint: PlacementTool arrowsCursor. aPoint isNil ifTrue: [^nil]. "User aborted" aBox _ model find: aPoint suchThat: [:it | it canMoveIndependently]. aBox isNil ifTrue: [^nil]. currentModel _ aBox manager. currentModel isNil ifTrue: [^nil]. aThing _ currentModel addShiftRegTo: aBox boundingBox. aThing isNil ifTrue: [^nil]. model changed: aThing! forLoop "add a new forLoop" self add: ForLoopBox! whileLoop "add a new whileLoop" self add: WhileLoopBox! ! FlowKitTool subclass: #FunctionTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! FunctionTool comment: 'FunctionTool is the concrete class for Tools that add Boxes that inherit from FunctionBox'! !FunctionTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'addition multiplication subtraction integer division real division minimum maximum') yellowButtonMessages: #(additionBox multiplicationBox subtractionBox integerDivisionBox realDivisionBox minBox maxBox)! ! !FunctionTool methodsFor: 'menu messages'! additionBox self add: AdditionBox! integerDivisionBox self add: IntegerDivisionBox! maxBox self add: MaxBox! minBox self add: MinBox! multiplicationBox self add: MultiplicationBox! realDivisionBox self add: RealDivisionBox! subtractionBox self add: SubtractionBox! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FunctionTool class instanceVariableNames: ''! !FunctionTool class methodsFor: 'accessing'! cursorOffset " return the offset of my cursor " ^ -8 @ -9! ! FlowKitTool subclass: #InputTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! InputTool comment: 'InputTool is the concrete class for Tools that add Boxes that inherit from InputBox'! !InputTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'Numeric-Box Numeric-Random Numeric-Tuner Numeric-Slider Boolean-Light Boolean-Hand Boolean-Arrows' lines: #(4 ) ) yellowButtonMessages: #(numericInputBox randomNumberInputBox digitalTunerInputBox sliderInputBox booleanLightInput booleanHandInput booleanArrowsInput)! ! !InputTool methodsFor: 'menu messages'! booleanArrowsInput self addWithCompanion: BooleanArrowsInput! booleanHandInput self addWithCompanion: BooleanHandInput! booleanLightInput self addWithCompanion: BooleanLightInput! digitalTunerInputBox self addWithCompanion: DigitalTunerInputBox! numericInputBox self addWithCompanion: NumericInputBox! randomNumberInputBox self addWithCompanion: RandomNumberInputBox! sliderInputBox self addWithCompanion: SliderInputBox! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! InputTool class instanceVariableNames: ''! !InputTool class methodsFor: 'accessing'! cursorOffset " return the offset of my cursor " ^-16 @ -16! ! FlowKitTool subclass: #LabelTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! LabelTool comment: 'LabelTool is the concrete class for Tools that add LabelBoxes'! !LabelTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'new label') yellowButtonMessages: #(newLabel)! ! !LabelTool methodsFor: 'menu messages'! newLabel "add a foible of type LabelBox" self add: LabelBox! ! FlowKitTool subclass: #OperatingTool instanceVariableNames: 'started ' classVariableNames: 'CurrentCursor ' poolDictionaries: '' category: 'FlowKit'! OperatingTool comment: 'OperatingTool is the concrete class for Tools that allow the user to enter input into Boxes '! !OperatingTool methodsFor: 'initialize'! startUp started _ false. super startUp! ! !OperatingTool methodsFor: 'menu messages'! autoStartOff "take program out of auto-start mode" self started: false. self installMenu! autoStartOn "initialize self and put program in auto start mode" self started: true. self installMenu! calculate "start calculation of all of the foibles" | aRectangle otherView otherModel | self started ifTrue: [otherView _ self otherView. otherModel _ otherView model. otherModel calculate. aRectangle _ model displayBox. aRectangle isNil ifFalse: [model changed: #value with: aRectangle]]! calibrate "Find a box, if it can be calibrated, ask it to do so" | aThing newPoint currentModel | newPoint _ self getPoint: self class calibrateCursor. currentModel _ model. newPoint isNil ifTrue: [^nil]. "User aborted" aThing _ model find: newPoint suchThat: [:it | it canBeCalibrated]. aThing isNil ifTrue: [^false]. aThing calibrate! change "give new input to the given FoibleBox" | aThing aPoint aRectangle newModel thingName newInput | aPoint _ self getPoint: Cursor currentCursor. aPoint isNil ifTrue: [^nil]. aThing _ model find: aPoint. aThing isNil ifTrue: [^nil]. newModel _ aThing owner. thingName _ aThing name. aThing canAcceptInput ifTrue: [newInput _ aThing acceptInput: aPoint - aThing offset. aRectangle _ newModel changeValue: thingName to: newInput. aRectangle class == String ifTrue: [PopUpNotifier message: aRectangle] ifFalse: [model changed: #value with: aRectangle. self calculate]]! redButtonActivity "red button activity for OperatingTool" self change! start "initialize self and put program in started state" self started: true. self calculate. self started: false! ! !OperatingTool methodsFor: 'menu setup'! buildYellowButtonMenu "answer with the yellow button menu for operating tool" self started ifTrue: [^'Calibrate Auto-Start Off Open Layout Save Layout'] ifFalse: [^'Calibrate Start (Manual) Auto-Start On Open Layout Save Layout']! buildYellowButtonMessages "answer messages for yellowbutton" self started ifTrue: [^#(calibrate autoStartOff open save )] ifFalse: [^#(calibrate start autoStartOn open save )]! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: self buildYellowButtonMenu lines: (self yellowButtonMenuLines)) yellowButtonMessages: self buildYellowButtonMessages! yellowButtonMenuLines "answer with array of lines used on yellow button menu for operating tool" self started ifTrue: [^#(1 2)] ifFalse: [^#(1 3)]! ! !OperatingTool methodsFor: 'private'! getPoint: aCursor "Get a point in the viewport and return its value, nil if left the viewport" | aPoint | aCursor show. [ Sensor noButtonPressed & controller isControlActive ] whileTrue: [aPoint _ Sensor cursorPoint]. model cursor show. controller isControlActive ifFalse: [^nil]. ^(view inverseDisplayTransform: (Sensor waitButton)) rounded! ! !OperatingTool methodsFor: 'accessing'! started "answer started or not" ^started! started: aBoolean "turn on/off" started _ aBoolean! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OperatingTool class instanceVariableNames: 'calibrateCursor '! !OperatingTool class methodsFor: 'accessing'! calibrateCursor calibrateCursor notNil ifTrue: [^calibrateCursor]. ^calibrateCursor _ (self getCursor: 'Calibrate.cur') offset: -7@-7! cursorOffset "Return the offset of my cursor" ^ 0 @ -6! ! FlowKitTool subclass: #OutputTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! OutputTool comment: 'OutputTool is the concrete class for Tools that add Boxes that inherit from OutputBox'! !OutputTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'Numeric-Box Numeric-LED Meter Numeric-Analog Meter Numeric-Plotter Boolean-Light Boolean-Hand Boolean-Arrows' lines: #(4 )) yellowButtonMessages: #(numericOutputBox ledMeterOutputBox analogMeterOutputBox plottedOutputBox booleanLight booleanHand booleanArrows )! ! !OutputTool methodsFor: 'menu messages'! analogMeterOutputBox self addWithCompanion: AnalogMeterOutputBox! booleanArrows self addWithCompanion: BooleanArrows! booleanHand self addWithCompanion: BooleanHand! booleanLight self addWithCompanion: BooleanLight! ledMeterOutputBox self addWithCompanion: LEDMeterOutputBox! numericOutputBox self addWithCompanion: NumericOutputBox! plottedOutputBox self addWithCompanion: PlottedOutputBox! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OutputTool class instanceVariableNames: ''! !OutputTool class methodsFor: 'accessing'! cursorOffset "Return the offset of my cursor" ^-16 @ -16! ! FlowKitTool subclass: #PlacementTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! PlacementTool comment: 'PlacementTool is the concrete class for Tools that allow the user to move, copy, and delete Boxes'! !PlacementTool methodsFor: 'menu messages'! copy "Find an object and copy it" | oldThing newPoint newImage aBox currentModel | newPoint _ self getPoint: self class arrowsCursor. currentModel _ model. newPoint isNil ifTrue: [^nil]. "User aborted" oldThing _ model find: newPoint suchThat: [:it | it canBeCopied]. oldThing isNil ifTrue: [^false]. Sensor cursorPoint: (view displayTransform: oldThing offset). newImage _ oldThing class asCursor. newPoint _ self getThingPoint: newImage. newPoint isNil ifTrue: [^nil]. currentModel _ self getManager: newPoint. currentModel isNil ifTrue: [^nil]. "The thing already exists, abort" Cursor wait show. oldThing _ currentModel addBox: [:name | oldThing class offset: newPoint withName: name withForm: newImage]. model changed: oldThing. model cursor show.! delete "Find an object and remove it from list, return nil if no find" | aPoint aThing aRectangle otherView otherModel companionBox otherRectangle | aPoint _ self getPoint: self class skullCursor. aPoint isNil ifTrue: [^nil]. "User aborted" aThing _ model find: aPoint suchThat: [:it | it canBeDeleted]. aThing isNil ifTrue: [^nil]. "No such object" (BinaryChoice message: 'Really delete ' , aThing name , '?') ifFalse: [^nil]. aRectangle _ aThing owner remove: aThing. model changed: aRectangle. otherView _ self otherView. otherModel _ otherView model. companionBox _ aThing companion. companionBox isNil ifFalse: [otherRectangle _companionBox owner remove: companionBox. otherModel changed: otherRectangle]! move "Find an object and move it" | oldThing newPoint aRectangle currentModel aBox | newPoint _ self getPoint: self class cursor. newPoint isNil ifTrue: [^nil]. "User aborted" oldThing _ model find: newPoint suchThat: [:it | it canMoveIndependently]. oldThing isNil ifTrue: [^nil]. (oldThing isKindOf: self defaultLinkClass) ifTrue: [aRectangle_self moveLine: oldThing point: newPoint]. (oldThing isKindOf: FoibleBox) ifTrue: [oldThing companion isNil ifFalse: [Display flash: (self otherView displayTransform: oldThing companion boundingBox)]. Sensor cursorPoint: (view displayTransform: oldThing offset). newPoint _ self getThingPoint: oldThing ghostForm. newPoint isNil ifTrue: [^nil]. currentModel _ model. aBox _ model find: newPoint suchThat: [:it | it isKindOf: FoibleBox]. aBox notNil ifTrue: [aBox = oldThing ifTrue: [currentModel _ aBox owner] ifFalse: [aBox manager notNil ifTrue: [currentModel _ aBox manager] ifFalse: [currentModel _ aBox owner]]. oldThing manager notNil ifTrue: [(aBox inside: oldThing manager) ifTrue: [currentModel _ oldThing owner]] ]. Cursor wait show. aRectangle _ currentModel moveBox: oldThing byBlock: [:box | box offset: newPoint]]. aRectangle notNil ifTrue: [model changed: aRectangle]. model cursor show! redButtonActivity self move! ! !PlacementTool methodsFor: 'menu setup'! installMenu "Install our menu" controller yellowButtonMenu: (PopUpMenu labels: 'delete copy') yellowButtonMessages: #(delete copy )! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PlacementTool class instanceVariableNames: 'arrowsCursor skullCursor '! !PlacementTool class methodsFor: 'accessing'! arrowsCursor arrowsCursor isNil ifTrue: [arrowsCursor _ (self getCursor: 'Arrows.cur') offset: -7@-7]. ^arrowsCursor! cursorOffset "Return the offset of my cursor" ^ -8 @ -9! skullCursor skullCursor isNil ifTrue: [skullCursor _ (self getCursor: 'Skull.cur') offset: -7@-9]. ^skullCursor! ! !PlacementTool class methodsFor: 'class initialization'! initializeForms " send this class method when the form for my icon or cursor has been changed " " <class name> initializeForms " icon _ self getIcon. skullCursor _ (self getCursor: 'Skull.cur') offset: -7@-9. arrowsCursor _ (self getCursor: 'Arrows.cur') offset: -7@-7. toolCursor _ self getCursor offset: self cursorOffset.! ! FlowKitTool subclass: #WiringTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! WiringTool comment: 'WiringTool is the concrete class for Tools that add Links '! !WiringTool methodsFor: 'menu setup'! installMenu "install our menu" controller yellowButtonMenu: nil yellowButtonMessages: nil! ! !WiringTool methodsFor: 'menu messages'! add "link this type of link" | fromThing toThing link path aProtoLink lines | aProtoLink _ self getPath. aProtoLink isNil ifTrue: [^nil]. fromThing _ aProtoLink origin. toThing _ aProtoLink destination. lines _ aProtoLink lines. link _fromThing box owner addLink: WiringLink from: fromThing to: toThing withPath: lines. link isNil ifTrue: [^nil]. model changed: link.! redButtonActivity "red button activity for WiringLinkTool" self add! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WiringTool class instanceVariableNames: ''! !WiringTool class methodsFor: 'accessing'! cursorOffset "Return the offset of my cursor" ^-12 @ -1! ! ToolBenchView subclass: #FlowKitView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FlowKit'! !FlowKitView methodsFor: 'subview access'! canvas ^canvas! otherView: aView " return a subview in canvas that is not equal to aView" self canvas do: [:each | each ~= aView ifTrue: [^each]]. ^nil! ! !FlowKitView methodsFor: 'initialize'! initializeWithModel: aFoibleProgram "Add the two sub-views: 2 canvases (with a dummy form for now)" | frontView backView | self model: aFoibleProgram. frontView _ CanvasView new. frontView model: (aFoibleProgram firstManager). self addSubView: frontView in: (0@0 extent: 0.5@1) borderWidth: 1. backView _ CanvasView new. backView model: (aFoibleProgram secondManager). self addSubView: backView in: (0.5@0 extent: 0.5@1) borderWidth: 1. canvas _ OrderedCollection with: frontView with: backView! ! !FlowKitView methodsFor: 'private'! installCanvasTools "tell my canvases what their Tools are" (self canvas at: 1) addTools: (OrderedCollection new add: OperatingTool new; add: PlacementTool new; add: LabelTool new; add: NullTool new; add: NullTool new; add: NullTool new; add: NullTool new; add: InputTool new; add: OutputTool new; add: NullTool new; yourself). (self canvas at: 2) addTools: (OrderedCollection new add: OperatingTool new; add: PlacementTool new; add: LabelTool new; add: WiringTool new; add: FunctionTool new; add: ComparisonTool new; add: BooleanTool new; add: NullTool new; add: NullTool new; add: ControlTool new; yourself)! tools "return an OrderdCollection of the icons for the palette" ^(OrderedCollection new add: OperatingTool icon; add: PlacementTool icon; add: LabelTool icon; add: WiringTool icon; add: FunctionTool icon; add: ComparisonTool icon; add: BooleanTool icon; add: InputTool icon; add: OutputTool icon; add: ControlTool icon; yourself)! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FlowKitView class instanceVariableNames: ''! !FlowKitView class methodsFor: 'instance creation'! open "Create a new FlowKitManager and open a FlowKitView on it" "FlowKitView open." self openOn: (FoibleProgram with: FlowKitManager new with: FlowKitManager new)! openProgram "Open an existing FlowKitView program; saved as a binary" "FlowKitView openProgram." ^super openProgram! openProgram: aName "Open an existing FlowKitView program saved as a binary" "FlowKitView openProgram: <aName>. " ^super openProgram: aName! !